home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / misc_lsp.arc / FILLET.LSP < prev    next >
Encoding:
Text File  |  1987-08-28  |  1.8 KB  |  59 lines
  1. ;
  2. (Defun c:fil ()
  3.   (setq pricounter 0 seccounter 1 itemcount 0 numberitems 0)
  4.   (setvar "cmdecho" 0)
  5.   (setq flag 0)
  6.   (setq tol (getreal "Tolerance ? "))
  7.   (prompt "\nSelect area to check for unfilleted lines ")
  8.   (setq a (ssget))
  9.   (textscr)
  10.   (setq numberitems (sslength a))
  11.   (while (<= pricounter (1- numberitems))
  12.     (setq pritem (ssname a pricounter))
  13.     (setq pri (entget pritem))
  14.     (if (= (cdr (assoc '0 pri)) "LINE")
  15.        (progn
  16.          (while (<= seccounter (- numberitems pricounter))
  17.            (setq secitem (ssname a (+ pricounter seccounter)))
  18.            (setq sec (entget secitem))
  19.            (if (= (cdr (assoc '0 pri)) "LINE")
  20.              (progn
  21.                (setq pt1 (cdr (assoc '10 pri)))
  22.                (setq pt2 (cdr (assoc '11 pri)))
  23.                (setq pt3 (cdr (assoc '10 sec)))
  24.                (setq pt4 (cdr (assoc '11 sec)))
  25. ;
  26.                (setq pt1x (car pt1))
  27.                (setq pt1y (cdr pt1))
  28.                (setq pt2x (car pt2))
  29.                (setq pt2y (cdr pt2))
  30.                (setq pt3x (car pt3))
  31.                (setq pt3y (cdr pt3))
  32.                (setq pt4x (car pt4))
  33.                (setq pt4y (cdr pt4))
  34. ;
  35.                (if (and (<= (abs (- pt1x pt3x))
  36.                             (abs (- pt1x pt3x))
  37.  
  38.  
  39.                (setq prix (car p))
  40.                (setq priy (cdr p))
  41.                (setq secx (car s))
  42.                (setq secy (cdr s))
  43.                (setq dx (abs (- prix secx)))
  44.                (setq dy (abs (- priy secy)))
  45.                (if (and (<= dx tol) (<= dy tol))
  46.                   (progn
  47.                     (command "fillet" pritem secitem)
  48.                   )
  49.                )
  50.              )
  51.            )
  52.            (setq seccounter (1+ seccounter))
  53.          )
  54.        )
  55.     )
  56.     (setq seccounter 1)
  57.     (setq pricounter (1+ pricounter))
  58.   )
  59. )